home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / dylan / func.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  3.3 KB  |  123 lines  |  [TEXT/ttxt]
  1. module: Dylan
  2. rcs-header: $Header: func.dylan,v 1.4 94/06/27 17:10:26 wlott Exp $
  3.  
  4. //======================================================================
  5. //
  6. // Copyright (c) 1994  Carnegie Mellon University
  7. // All rights reserved.
  8. // 
  9. // Use and copying of this software and preparation of derivative
  10. // works based on this software are permitted, including commercial
  11. // use, provided that the following conditions are observed:
  12. // 
  13. // 1. This copyright notice must be retained in full on any copies
  14. //    and on appropriate parts of any derivative works.
  15. // 2. Documentation (paper or online) accompanying any system that
  16. //    incorporates this software, or any part of it, must acknowledge
  17. //    the contribution of the Gwydion Project at Carnegie Mellon
  18. //    University.
  19. // 
  20. // This software is made available "as is".  Neither the authors nor
  21. // Carnegie Mellon University make any warranty about the software,
  22. // its performance, or its conformity to any specification.
  23. // 
  24. // Bug reports, questions, comments, and suggestions should be sent by
  25. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  26. //
  27. //======================================================================
  28. //
  29. //  This file contains the stuff from the functional operations chapter.
  30. //
  31.  
  32. define method compose (function, #rest more-functions)
  33.   if (empty?(more-functions))
  34.     function;
  35.   else
  36.     let next = apply(compose, more-functions);
  37.     method (#rest args)
  38.       function(apply(next, args));
  39.     end;
  40.   end;
  41. end;
  42.  
  43. define method complement (predicate)
  44.   method (#rest args)
  45.     ~apply(predicate, args);
  46.   end;
  47. end;
  48.  
  49. define method disjoin (predicate, #rest more-predicates)
  50.   if (empty?(more-predicates))
  51.     predicate;
  52.   else
  53.     let next = apply(disjoin, more-predicates);
  54.     method (#rest args)
  55.       apply(predicate, args) | apply(next, args);
  56.     end;
  57.   end;
  58. end;
  59.  
  60. define method conjoin (predicate, #rest more-predicates)
  61.   if (empty?(more-predicates))
  62.     predicate;
  63.   else
  64.     let next = apply(conjoin, more-predicates);
  65.     method (#rest args)
  66.       apply(predicate, args) & apply(next, args);
  67.     end;
  68.   end;
  69. end;
  70.  
  71. define method curry (function, #rest curried-args)
  72.   method (#rest args)
  73.     apply-curry(function, curried-args, args);
  74.   end;
  75. end;
  76.  
  77. define method rcurry (function, #rest curried-args)
  78.   method (#rest args)
  79.     apply-curry(function, args, curried-args);
  80.   end;
  81. end;
  82.  
  83. define method always (object)
  84.   method (#rest args)
  85.     object;
  86.   end;
  87. end;
  88.  
  89. define method applicable-method? (gf :: <generic-function>, #rest args)
  90.   any?(method (meth)
  91.      apply(applicable-method?, meth, args);
  92.        end,
  93.        generic-function-methods(gf));
  94. end;
  95.  
  96. define method make-next-method-function (methods, #rest orig-args)
  97.   if (empty?(methods))
  98.     #f;
  99.   else
  100.     method (#rest new-args)
  101.       do-next-method(methods,
  102.              if (empty?(new-args))
  103.                orig-args;
  104.              else
  105.                new-args;
  106.              end);
  107.     end;
  108.   end;
  109. end;
  110.  
  111. define method generic-apply (function :: <function>, #rest arguments)
  112.   let num-regular-args = size(arguments) - 1;
  113.   let more-args = element(arguments, num-regular-args);
  114.   let new-args = make(<vector>, size: num-regular-args + size(more-args));
  115.   for (i from 0 below num-regular-args)
  116.     new-args[i] := arguments[i];
  117.   end;
  118.   for (arg in more-args, i from num-regular-args)
  119.     new-args[i] := arg;
  120.   end;
  121.   apply(function, new-args);
  122. end;
  123.